home *** CD-ROM | disk | FTP | other *** search
/ Workbench Add-On / Workbench Add-On - Volume 1.iso / BBS-Archive / Dev / Obrn-A_1.6_lib.lha / oberon-a / source3.lha / source / Obsolete / BigSets.mod < prev    next >
Text File  |  1995-06-29  |  5KB  |  186 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: BigSets.mod $
  4.   Description: An implementation of sets bigger than a machine word.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.8 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/29 19:06:56 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. ***************************************************************************)
  16.  
  17. MODULE BigSets;
  18.  
  19. IMPORT U := Util;
  20.  
  21. CONST
  22.  
  23.   BitsPerSet * = MAX (SET) + 1;
  24.   CharSetElements = ORD (MAX (CHAR)) DIV BitsPerSet;
  25.  
  26. TYPE
  27.  
  28.   CHARSET * = ARRAY CharSetElements OF SET;
  29.  
  30. (*------------------------------------*)
  31. PROCEDURE Empty * ( VAR set : ARRAY OF SET );
  32.  
  33.   VAR index : INTEGER;
  34.  
  35. BEGIN (* Empty *)
  36.   index := 0;
  37.   WHILE index < LEN (set) DO
  38.     set [index] := {};
  39.     INC (index)
  40.   END; (* WHILE *)
  41. END Empty;
  42.  
  43. (*------------------------------------*)
  44. PROCEDURE IsEmpty * ( VAR set : ARRAY OF SET ) : BOOLEAN;
  45.  
  46.   VAR index : INTEGER; empty : BOOLEAN;
  47.  
  48. BEGIN (* IsEmpty *)
  49.   empty := TRUE; index := 0;
  50.   WHILE empty & (index < LEN (set)) DO
  51.     empty := (set [index] = {});
  52.     INC( index );
  53.   END; (* WHILE *)
  54.   RETURN empty;
  55. END IsEmpty;
  56.  
  57. (*------------------------------------*)
  58. PROCEDURE In * ( VAR set : ARRAY OF SET; element : INTEGER ) : BOOLEAN;
  59.  
  60.   VAR index, bit : INTEGER;
  61.  
  62. BEGIN (* In *)
  63.   index := element DIV BitsPerSet;
  64.   bit := element MOD BitsPerSet;
  65.   RETURN (bit IN set [index]);
  66. END In;
  67.  
  68. (*------------------------------------*)
  69. PROCEDURE Incl * ( VAR set : ARRAY OF SET; element : INTEGER );
  70.  
  71.   VAR index, bit : INTEGER;
  72.  
  73. BEGIN (* Incl *)
  74.   index := element DIV BitsPerSet;
  75.   bit := element MOD BitsPerSet;
  76.   INCL (set [index], bit);
  77. END Incl;
  78.  
  79. (*------------------------------------*)
  80. PROCEDURE Excl * ( VAR set : ARRAY OF SET; element : INTEGER );
  81.  
  82.   VAR index, bit : INTEGER;
  83.  
  84. BEGIN (* Excl *)
  85.   index := element DIV BitsPerSet;
  86.   bit := element MOD BitsPerSet;
  87.   EXCL (set [index], bit);
  88. END Excl;
  89.  
  90. (*------------------------------------*)
  91. PROCEDURE InclRange * (
  92.   VAR set : ARRAY OF SET; firstElement, lastElement : INTEGER );
  93.  
  94.   VAR index, bit, count : INTEGER;
  95.  
  96. BEGIN (* InclRange *)
  97.   index := firstElement DIV BitsPerSet;
  98.   bit := firstElement MOD BitsPerSet;
  99.   count := lastElement - firstElement + 1;
  100.   WHILE count > 0 DO
  101.     INCL (set [index], bit);
  102.     INC (bit);
  103.     IF bit = BitsPerSet THEN
  104.       bit := 0;
  105.       INC (index);
  106.     END; (* IF *)
  107.     DEC (count);
  108.   END; (* WHILE *)
  109. END InclRange;
  110.  
  111. (*------------------------------------*)
  112. PROCEDURE ExclRange * (
  113.   VAR set : ARRAY OF SET; firstElement, lastElement : INTEGER );
  114.  
  115.   VAR index, bit, count : INTEGER;
  116.  
  117. BEGIN (* ExclRange *)
  118.   index := firstElement DIV BitsPerSet;
  119.   bit := firstElement MOD BitsPerSet;
  120.   count := lastElement - firstElement + 1;
  121.   WHILE count > 0 DO
  122.     EXCL (set [index], bit);
  123.     INC (bit);
  124.     IF bit = BitsPerSet THEN
  125.       bit := 0;
  126.       INC (index);
  127.     END; (* IF *)
  128.     DEC (count);
  129.   END; (* WHILE *)
  130. END ExclRange;
  131.  
  132. (*------------------------------------*)
  133. PROCEDURE Union * ( VAR firstSet, secondSet, destSet : ARRAY OF SET );
  134.  
  135.   VAR index, maxIndex : INTEGER;
  136.  
  137. BEGIN (* Union *)
  138.   index := 0; maxIndex := SHORT (LEN (firstSet));
  139.   WHILE index < maxIndex DO
  140.     destSet [index] := firstSet [index] + secondSet [index];
  141.     INC (index)
  142.   END; (* WHILE *)
  143. END Union;
  144.  
  145. (*------------------------------------*)
  146. PROCEDURE Difference * ( VAR firstSet, secondSet, destSet : ARRAY OF SET );
  147.  
  148.   VAR index, maxIndex : INTEGER;
  149.  
  150. BEGIN (* Difference *)
  151.   index := 0; maxIndex := SHORT (LEN (firstSet));
  152.   WHILE index < maxIndex DO
  153.     destSet [index] := firstSet [index] - secondSet [index];
  154.     INC (index)
  155.   END; (* WHILE *)
  156. END Difference;
  157.  
  158. (*------------------------------------*)
  159. PROCEDURE Intersection * (VAR firstSet, secondSet, destSet : ARRAY OF SET);
  160.  
  161.   VAR index, maxIndex : INTEGER;
  162.  
  163. BEGIN (* Intersection *)
  164.   index := 0; maxIndex := SHORT (LEN (firstSet));
  165.   WHILE index < maxIndex DO
  166.     destSet [index] := firstSet [index] * secondSet [index];
  167.     INC (index)
  168.   END; (* WHILE *)
  169. END Intersection;
  170.  
  171. (*------------------------------------*)
  172. PROCEDURE SymmetricDiff * (VAR firstSet, secondSet, destSet : ARRAY OF SET);
  173.  
  174.   VAR index, maxIndex : INTEGER;
  175.  
  176. BEGIN (* SymmetricDiff *)
  177.   index := 0; maxIndex := SHORT (LEN (firstSet));
  178.   WHILE index < maxIndex DO
  179.     destSet [index] := firstSet [index] / secondSet [index];
  180.     INC (index)
  181.   END; (* WHILE *)
  182. END SymmetricDiff;
  183.  
  184. END BigSets.
  185.  
  186.